home *** CD-ROM | disk | FTP | other *** search
Text File | 1987-11-14 | 2.5 KB | 143 lines | [TEXT/PJMM] |
- UNIT stringf;
- INTERFACE
- VAR
- upalpha : STRING;
- lowalpha : STRING;
- PROCEDURE sstrip (VAR word : STRING);
- PROCEDURE wreverse (VAR word : STRING);
- PROCEDURE upper (VAR word : STRING);
- PROCEDURE makealpha (VAR word : STRING);
- FUNCTION alphsize : integer;
- FUNCTION strcmp (s, t : STRING) : integer;
-
- IMPLEMENTATION
- FUNCTION alphsize;
- BEGIN
- alphsize := length(upalpha);
- END;
- FUNCTION inpos (c : char) : integer;
- VAR
- i : integer;
- BEGIN
- i := 0;
- REPEAT
- i := i + 1;
- UNTIL (c = lowalpha[i]) OR (i = alphsize);
- IF c = lowalpha[i] THEN
- inpos := i
- ELSE
- inpos := 0;
- END;
-
- PROCEDURE sstrip;
- VAR
- i : integer;
- s : STRING;
- BEGIN
- i := 1;
- s := word;
- WHILE i <= length(s) DO
- IF s[i] = ' ' THEN
- delete(s, i, 1)
- ELSE
- i := i + 1;
- word := s;
- END;
- (* returns the place in the alphabet of upalpha*)
- FUNCTION index (c : char) : integer;
- VAR
- i : integer;
- st : STRING;
- BEGIN
- st := upalpha;
- i := 0;
- IF length(st) > 0 THEN
- REPEAT
- i := i + 1;
- UNTIL (c = st[i]) OR (i = length(st));
- IF c = st[i] THEN
- index := i
- ELSE
- index := 0;
- END;
-
- (* based on the c function with the same name*)
- (*This function returns 1 if s is > t, - 1 if s < t*)
- (* and 0 if s and t are identical. Comparison is done*)
- (* using upalpha*)
- FUNCTION strcmp;
- VAR
- i, j : integer;
- u, v : STRING;
- BEGIN
- u := s;
- v := t;
- i := 1;
- WHILE (index(u[i]) = index(v[i])) AND (i < length(u)) AND (i < length(v)) DO
- i := i + 1;
- IF i = length(s) THEN
- strcmp := 0
- ELSE IF index(u[i]) > index(v[i]) THEN
- strcmp := 1
- ELSE IF index(u[i]) < index(v[i]) THEN
- strcmp := -1
- ELSE
- strcmp := 0;
- END;
-
-
- PROCEDURE wreverse;
- VAR
- i, l : integer;
- s : STRING;
- BEGIN
- s := word;
- l := length(word);
- FOR i := 1 TO l DO
- word[i] := s[l - i + 1];
- END;
- PROCEDURE upper;
- VAR
- i, lowtest : integer;
- s : STRING;
- BEGIN
- s := word;
- FOR i := 1 TO length(s) DO
- BEGIN
- lowtest := inpos(s[i]);
- IF lowtest <> 0 THEN
- s[i] := upalpha[lowtest];
- END;
- word := s;
- END;
- FUNCTION inup (c : char) : boolean;
- VAR
- i : integer;
- s : STRING;
- BEGIN
- i := 0;
- REPEAT
- i := i + 1;
- UNTIL (i = alphsize) OR (upalpha[i] = c);
- IF upalpha[i] = c THEN
- inup := true
- ELSE
- inup := false;
- END;
- PROCEDURE makealpha;
- VAR
- i : integer;
- s : STRING;
- lowers, uppers : SET OF char;
- BEGIN
- i := 1;
- s := word;
- upper(s);
- WHILE i <= length(s) DO
- IF NOT inup(s[i]) THEN
- delete(s, i, 1) {zap that character}
- ELSE
- i := i + 1;
- word := s;
- END;
- END.